Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue61/Clinic/Object Browser/ObjectBrowserFormU.pas

Pascal/Delphi Source File | 2000-03-29 | 14.1 KB | 503 lines

unit ObjectBrowserFormU;

{$ifdef Ver100} { Delphi 3.0x }
  {$define DelphiLessThan4}
  {$define DelphiLessThan5}
{$endif}
{$ifdef Ver110} { C++ Builder 3.0x }
  {$define DelphiLessThan4}
  {$define DelphiLessThan5}
{$endif}
{$ifdef Ver120} { Delphi 4.0x }
  {$define DelphiLessThan5}
{$endif}

interface

uses
  TypInfo,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, Grids, Menus;

type
  TObjectBrowserForm = class(TForm)
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    TvOwnerHierarchy: TTreeView;
    Label1: TLabel;
    BtnUpdate: TButton;
    GrdProp: TStringGrid;
    TCPropType: TTabControl;
    Label2: TLabel;
    TvChildrenHierarchy: TTreeView;
    Splitter3: TSplitter;
    Label3: TLabel;
    LstClassHierarchy: TListBox;
    mnuOwnerHierarchy: TPopupMenu;
    itmShowActions: TMenuItem;
    itmShowMenuItems: TMenuItem;
    itmShowActionLists: TMenuItem;
    itmShowPropSets: TMenuItem;
    itmShowPropFields: TMenuItem;
    edtPropValue: TEdit;
    itmHighlightControl: TMenuItem;
    N1: TMenuItem;
    Bar: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ObjectInspectorResize(Sender: TObject);
    procedure BtnUpdateClick(Sender: TObject);
    procedure TvHierarchyChange(Sender: TObject; Node: TTreeNode);
    procedure TCPropTypeChange(Sender: TObject);
    procedure MenuItemClick(Sender: TObject);
    procedure GrdPropSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure edtPropValueKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edtPropValueKeyPress(Sender: TObject; var Key: Char);
    procedure GrdPropMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure GrdPropDblClick(Sender: TObject);
  private
    { Private declarations }
    //Flag to stop recursion when tree views change
    Busy: Boolean;
    //The object being displayed in the Object Inspector
    Obj: TObject;
    procedure ListComponents(Root: TComponent; RootNode: TTreeNode);
    procedure ListChildren(Control: TWinControl; RootNode: TTreeNode);
    procedure ListClasses(Obj: TObject);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMEnable(var Msg: TWMEnable);
      message wm_Enable;
  public
    { Public declarations }
    procedure ShowChildrenHierarchy;
    procedure ShowClassHierarchy;
    procedure ShowProperties;
  end;

var
  ObjectBrowserForm: TObjectBrowserForm;

implementation

uses
{$ifndef DelphiLessThan4}
  ActnList,
{$endif}
  Registry, SetEditorFormU, StringsEditorFormU, PropertyHelper;

{$R *.DFM}

const
  RegPath = 'Software\Oblong';
  RegSection = 'Object Browser';

type
  TStringGridAccess = class(TStringGrid);

function InheritsFromText(Obj: TObject; const ClsName: String): Boolean;
var
  SenderClass: TClass;
begin
  SenderClass := Obj.ClassType;
  Result := True;
  while SenderClass <> nil do
    if SenderClass.ClassName = ClsName then
      Exit
    else
      SenderClass := SenderClass.ClassParent;
  Result := False;
end;

procedure TObjectBrowserForm.FormCreate(Sender: TObject);
begin
{$ifdef DelphiLessThan4}
  itmShowActionLists.Visible := False;
  itmShowActions.Visible := False;
{$endif}
  with TRegIniFile.Create(RegPath) do
    try
      itmHighlightControl.Checked :=
        ReadBool(RegSection, itmHighlightControl.Name, itmHighlightControl.Checked);
    {$ifndef DelphiLessThan4}
      itmShowActions.Checked :=
        ReadBool(RegSection, itmShowActions.Name, itmShowActions.Checked);
      itmShowActionLists.Checked :=
        ReadBool(RegSection, itmShowActionLists.Name, itmShowActionLists.Checked);
    {$endif}
      itmShowMenuItems.Checked :=
        ReadBool(RegSection, itmShowMenuItems.Name, itmShowMenuItems.Checked);
      itmShowPropFields.Checked :=
        ReadBool(RegSection, itmShowPropFields.Name, itmShowPropFields.Checked);
      itmShowPropSets.Checked :=
        ReadBool(RegSection, itmShowPropSets.Name, itmShowPropSets.Checked);
    finally
      Free
    end;
end;

procedure TObjectBrowserForm.FormShow(Sender: TObject);
begin
  BtnUpdate.Click;
end;

procedure TObjectBrowserForm.ObjectInspectorResize(Sender: TObject);
begin
  GrdProp.DefaultColWidth := (Sender as TWinControl).Width div 2;
  TStringGridAccess(GrdProp).SelectCell(GrdProp.Col, GrdProp.Row)
end;

procedure TObjectBrowserForm.ListComponents(Root: TComponent; RootNode: TTreeNode);
var
  Loop: Integer;
begin
  for Loop := 0 to Root.ComponentCount - 1 do
    if not (((Root.Components[Loop] is TMenuItem) and not itmShowMenuItems.Checked) or
          {$ifndef DelphiLessThan4}
            ((Root.Components[Loop] is TCustomAction) and not itmShowActions.Checked) or
            ((Root.Components[Loop] is TCustomActionList) and not itmShowActionLists.Checked) or
          {$endif}
            ((InheritsFromText(Root.Components[Loop], 'TPropField')) and not itmShowPropFields.Checked) or
            ((InheritsFromText(Root.Components[Loop], 'TPropSet')) and not itmShowPropSets.Checked)) then
      ListComponents(
        Root.Components[Loop],
        TvOwnerHierarchy.Items.AddChildObject(
          RootNode,
          Format('%s (%s)',
            [Root.Components[Loop].Name,
             Root.Components[Loop].ClassName]),
          Root.Components[Loop]))
end;

procedure TObjectBrowserForm.BtnUpdateClick(Sender: TObject);
begin
  Busy := True;
  try
    TvChildrenHierarchy.Items.Clear;
    LstClassHierarchy.Items.Clear;
    TvOwnerHierarchy.Items.BeginUpdate;
    try
      TvOwnerHierarchy.Items.Clear;
      ListComponents(
        Application,
        TvOwnerHierarchy.Items.AddObject(
          nil,
          'Application (TApplication)',
          Pointer(Application)));
      TvOwnerHierarchy.TopItem := TvOwnerHierarchy.Items[0];
      TvOwnerHierarchy.Items[0].Expand(False)
    finally
      TvOwnerHierarchy.Items.EndUpdate
    end
  finally
    Busy := False
  end
end;

procedure TObjectBrowserForm.TvHierarchyChange(Sender: TObject;
  Node: TTreeNode);
var
  Loop: Integer;
  Rect: TRect;
  Canvas: TCanvas;
  Ctl: TControl;
begin
  if Busy then Exit;
  Busy := True;
  try
    Obj := TObject(Node.Data);
    ShowClassHierarchy;
    //This code causes the other tree view to change, causing
    //possible recursion, hence the Busy flag to stop that
    if Sender = TvOwnerHierarchy then
      ShowChildrenHierarchy;
    ShowProperties;
    edtPropValue.Hide;
    if itmHighlightControl.Checked and (Obj is TControl) then
    begin
      Ctl := Obj as TControl;
      Canvas := TCanvas.Create;
      try
        Rect := Ctl.ClientRect;
        Rect.BottomRight := Point(Rect.Left + Rect.Right, Rect.Top + Rect.Bottom);
        Rect.TopLeft := Ctl.ClientToScreen(Rect.TopLeft);
        Rect.BottomRight := Ctl.ClientToScreen(Rect.BottomRight);
        Canvas.Pen.Mode := pmNot;
        Canvas.Pen.Width := 5;
        Canvas.Handle := GetDC(HWnd_Desktop);
        try
          for Loop := 1 to 8 do
          begin
            Canvas.Polyline([Rect.TopLeft, Point(Rect.Right, Rect.Top),
                             Rect.BottomRight, Point(Rect.Left, Rect.Bottom),
                             Rect.TopLeft]);
            Sleep(50);
          end
        finally
          ReleaseDC(HWnd_Desktop, Canvas.Handle)
        end
      finally
        Canvas.Free
      end
    end;
  finally
    Busy := False
  end
end;

procedure TObjectBrowserForm.ListChildren(Control: TWinControl; RootNode: TTreeNode);
var
  Loop: Integer;
  NewNode: TTreeNode;
begin
  for Loop := 0 to Control.ControlCount - 1 do
  begin
    NewNode := TvChildrenHierarchy.Items.AddChildObject(
      RootNode, Format('%s (%s)',
        [Control.Controls[Loop].Name,
         Control.Controls[Loop].ClassName]),
      Control.Controls[Loop]);
    if Control.Controls[Loop] is TWinControl then
      ListChildren(TWinControl(Control.Controls[Loop]), NewNode);
  end
end;

procedure TObjectBrowserForm.ShowChildrenHierarchy;
var
  WC: TWinControl;
begin
  TvChildrenHierarchy.Items.BeginUpdate;
  try
    TvChildrenHierarchy.Items.Clear;
    if Obj is TWinControl then
    begin
      WC := TWinControl(Obj);
      ListChildren(
        WC,
        TvChildrenHierarchy.Items.AddObject(
          nil,
          Format('%s (%s)', [WC.Name, WC.ClassName]),
          WC));
      end;
    TvChildrenHierarchy.FullExpand
  finally
    TvChildrenHierarchy.Items.EndUpdate
  end
end;

procedure TObjectBrowserForm.ListClasses(Obj: TObject);
var
  CurrentClass: TClass;
begin
  CurrentClass := Obj.ClassType;
  while Assigned(CurrentClass) do
  begin
    LstClassHierarchy.Items.Insert(0, CurrentClass.ClassName);
    CurrentClass := CurrentClass.ClassParent
  end
end;

procedure TObjectBrowserForm.ShowClassHierarchy;
begin
  LstClassHierarchy.Items.BeginUpdate;
  try
    LstClassHierarchy.Items.Clear;
    ListClasses(Obj)
  finally
    LstClassHierarchy.Items.EndUpdate
  end
end;

procedure TObjectBrowserForm.TCPropTypeChange(Sender: TObject);
begin
  ShowProperties;
  edtPropValue.Hide;
end;

procedure TObjectBrowserForm.ShowProperties;
const
  PropTypes: array[0..1] of TTypeKinds = (tkProperties, tkMethods);
var
  Loop: Integer;
  List: TPropList;
  Count: Integer;
begin
  FillChar(List, SizeOf(List), 0);
  Count := GetPropList(
    Obj.ClassInfo, PropTypes[TCPropType.TabIndex], @List);
  //If you set a grid's row count to 0, it sets it to 1
  GrdProp.RowCount := Count;
  if Count = 0 then
  begin
    GrdProp.Cells[0, 0] := '';
    GrdProp.Cells[1, 0] := '';
  end;
  //Loop through properties, getting a text version to display
  for Loop := 0 to Count - 1 do
  begin
    GrdProp.Cells[0, Loop] := List[Loop].Name;
    GrdProp.Cells[1, Loop] := GetPropValue(Obj, List[Loop]);
    GrdProp.Objects[1, Loop] := TObject(List[Loop]);
  end
end;

procedure TObjectBrowserForm.MenuItemClick(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    with TRegIniFile.Create(RegPath) do
      try
        WriteBool(RegSection, Name, Checked)
      finally
        Free
      end;
    end;
  if Sender <> itmHighlightControl then
    BtnUpdate.Click
end;

procedure TObjectBrowserForm.GrdPropSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  Bar.SimpleText := '';
  if ACol = 1 then
    with edtPropValue do
    begin
      Parent := GrdProp;
      Text := GrdProp.Cells[ACol, ARow];
      Show;
      BoundsRect := GrdProp.CellRect(ACol, ARow);
      SelectAll;
      SetFocus
    end
end;

procedure TObjectBrowserForm.edtPropValueKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if Key in [vk_Return, vk_Up, vk_Down] then
  begin
    Bar.SimpleText := '';
    try
      SetPropValue(Obj,
        PPropInfo(GrdProp.Objects[1, GrdProp.Row]), edtPropValue.Text);
    except
      on E: Exception do
        Bar.SimpleText := E.Message
    end;
    ShowProperties;
    case Key of
      vk_Return:
        edtPropValue.Text := GetPropValue(Obj,
          PPropInfo(GrdProp.Objects[1, GrdProp.Row]));
      vk_Up:
        if GrdProp.Row > 0 then
          GrdProp.Row := GrdProp.Row - 1;
      vk_Down:
        if GrdProp.Row <= GrdProp.RowCount then
          GrdProp.Row := GrdProp.Row + 1;
    end;
    Key := 0
  end;
end;

procedure TObjectBrowserForm.edtPropValueKeyPress(Sender: TObject;
  var Key: Char);
begin
  case Key of
    #13: Key := #0;
  end
end;

procedure TObjectBrowserForm.GrdPropMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  Col, Row: Integer;
const
  GR: TGridRect = (Left: -1; Top: -1; Right: -1; Bottom: -1);
begin
  GrdProp.MouseToCell(X, Y, Col, Row);
  if Col = 0 then
  begin
    GR.Left := 1;
    GR.Top := Row;
    GR.BottomRight := GR.TopLeft;
    GrdProp.Selection := GR;
    TStringGridAccess(GrdProp).SelectCell(1, Row);
  end;
end;

procedure TObjectBrowserForm.GrdPropDblClick(Sender: TObject);
var
  PropInfo: PPropInfo;
  PropTypeInfo: PTypeInfo;
  PropTypeData: PTypeData;
  PropClass: TClass;
begin
  PropInfo := PPropInfo(GrdProp.Objects[1, GrdProp.Row]);
  PropTypeInfo := PropInfo.PropType^;
  PropTypeData := GetTypeData(PropTypeInfo);
  case PropTypeInfo.Kind of
    tkInteger:
      if Pos('Color', PropInfo.Name) > 0 then
        with TColorDialog.Create(Application) do
          try
            Color := GetOrdProp(Obj, PropInfo);
            if Execute then
              SetOrdProp(Obj, PropInfo, Color)
          finally
            Free
          end;
    tkSet: DisplayModalAndFree(
             TSetEditorForm.Create(Obj, PropInfo));
    tkClass:
    begin
      PropClass := PropTypeData.ClassType;
      //Check for TStrings
      if PropClass.InheritsFrom(TStrings) then
        DisplayModalAndFree(
          TStringsEditorForm.Create(Obj, PropInfo))
      else
      //Check for TFont
      if PropClass.InheritsFrom(TFont) then
        with TFontDialog.Create(Application) do
          try
            Font := TFont(GetObjectProp(Obj, PropInfo, TFont));
            if Execute then
              SetObjectProp(Obj, PropInfo, Font)
          finally
            Free
          end;
    end
  end;
  //After potentially changing a property (say Color),
  //Re-read properties into Object Inspector...
  ShowProperties;
  //...and update the edit control, if needs be
  TStringGridAccess(GrdProp).SelectCell(1, GrdProp.Row);
end;

procedure TObjectBrowserForm.CreateParams(var Params: TCreateParams);
begin
  inherited;
  //Make Object Browser have task bar button of its own
  Params.WndParent := HWnd_Desktop
end;

procedure TObjectBrowserForm.WMEnable(var Msg: TWMEnable);
begin
  inherited;
  //When another form is modally displayed,
  //stop this one being disabled
  if not Msg.Enabled then
    EnableWindow(Handle, True)
end;

initialization
  RegisterClass(TPanel)
end.